unit UnitTestForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, StdActns, ActnList, Buttons, ExtCtrls, UnitTest,
  ComCtrls, CheckLst, ToolWin, Contnrs, ImgList;

type
  TTestResult = class;
  TUnitTestForm = class(TForm, ITestLog)
    ActionList1: TActionList;
    actRunTests: TAction;
    actClose: TWindowClose;
    actStop: TAction;
    pcTests: TPageControl;
    tsTestList: TTabSheet;
    tsResults: TTabSheet;
    Panel1: TPanel;
    sbRun: TSpeedButton;
    sbStop: TSpeedButton;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    seParalels: TSpinEdit;
    CheckListBox1: TCheckListBox;
    ListView1: TListView;
    tsLog: TTabSheet;
    actAllResults: TAction;
    actLog: TAction;
    Memo1: TMemo;
    ImageList1: TImageList;
    SpeedButton3: TSpeedButton;
    CheckBox1: TCheckBox;
    lbFailuredCount: TLabel;
    procedure actRunTestsExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actAllResultsExecute(Sender: TObject);
    procedure ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure ListView1Resize(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure actStopExecute(Sender: TObject);
    procedure actLogExecute(Sender: TObject);
  strict private
    fResults: TObjectList;
    fSelectedItems: TList;
    fFailured: Integer;
  protected
    function All: Boolean;
    procedure ClearResults;
    procedure RefreshList;
    procedure BeginTest;
    procedure EndTest;
    procedure AddResult(const t: TTestResult);
    // ITestLog interface
    procedure Accepted(const aName: string);
    procedure Failured(const aTest: TTestProc; const aName: string; const log: string);
    procedure Finished;
  public
    class procedure Run(const ShowFailuredOnly: Boolean = True);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TTestResult = class
  strict private
    fTestProc: TTestProc;
    fName: string;
    fLog: string;
    function GetOk: Boolean; inline;
  public
    constructor CreateOk(const aName: string);
    constructor CreateFailured(const aTestProc: TTestProc; const aName: string; const aLog: string);
    property Name: string read fName;
    property Log: string read fLog;
    property TestProc: TTestProc read fTestProc;
    property Ok: Boolean read GetOk;
  end;

implementation

{$R *.dfm}

procedure TUnitTestForm.actAllResultsExecute(Sender: TObject);
begin
  RefreshList;
end;

procedure TUnitTestForm.actLogExecute(Sender: TObject);
var
  l: string;
  tr: TTestResult;
  p: Pointer;
begin
  if fSelectedItems.Count = 0 then
    raise Exception.Create('Nothing selected');
  l := '';
  for p in fSelectedItems do
  begin
    tr := TTestResult(TListItem(p).Data);
    if not tr.Ok then
      l := l + tr.Log + sLineBreak + sLineBreak;
  end;
  Memo1.Text := l;
  tsLog.Enabled := True;
  pcTests.ActivePage := tsLog;
end;

procedure TUnitTestForm.actRunTestsExecute(Sender: TObject);
begin
  ClearResults;
  BeginTest;
  RunTests(Self, seParalels.Value);
end;

procedure TUnitTestForm.actStopExecute(Sender: TObject);
begin
  raise Exception.Create('not implemented');
  EndTest;
end;

procedure TUnitTestForm.AddResult(const t: TTestResult);
begin
  fResults.Add(t);
  if All or not t.Ok then
    ListView1.AddItem(t.Name, t);
end;

function TUnitTestForm.All: Boolean;
begin
  Result := actAllResults.Checked;
end;

procedure TUnitTestForm.BeginTest;
begin
  actRunTests.Enabled := False;
  actStop.Enabled := True;
  actLog.Enabled := False;
  pcTests.ActivePage := tsResults;
  tsTestList.Enabled := False;
  tsLog.Enabled := False;
  tsResults.Enabled := True;
  fFailured := 0;
end;

procedure TUnitTestForm.ClearResults;
begin
  ListView1.Items.Clear;
  fResults.Clear;
  actLog.Enabled := False;
  pcTests.ActivePage := tsTestList;
  tsResults.Enabled := False;
  tsLog.Enabled := False;
  tsTestList.Enabled := True;
end;

constructor TUnitTestForm.Create(AOwner: TComponent);
begin
  inherited;
  fResults := TObjectList.Create(True);
  fSelectedItems := TList.Create;
  actLog.Enabled := False;
end;

destructor TUnitTestForm.Destroy;
begin
  FreeAndNil(fSelectedItems);
  FreeAndNil(fResults);
  inherited;
end;

procedure TUnitTestForm.EndTest;
begin
  actRunTests.Enabled := True;
  actStop.Enabled := False;
  actLog.Enabled := True;
  tsTestList.Enabled := True;
  tsLog.Enabled := False;
end;

procedure TUnitTestForm.Accepted(const aName: string);
begin
  AddResult(TTestResult.CreateOk(aName));
end;

procedure TUnitTestForm.Failured(const aTest: TTestProc; const aName: string; const log: string);
begin
  AddResult(TTestResult.CreateFailured(aTest, aName, log));
  Inc(fFailured);
end;

procedure TUnitTestForm.Finished;
begin
  EndTest;
  if fFailured = 0 then
  begin
    lbFailuredCount.Caption := 'All test were accepted';
    actAllResults.Checked := True;
  end
  else
    lbFailuredCount.Caption := IntToStr(fFailured) + ' test failured';
end;

procedure TUnitTestForm.FormCreate(Sender: TObject);
begin
  actRunTests.Enabled := True;
  actStop.Enabled := False;
end;

procedure TUnitTestForm.ListView1CustomDrawItem(Sender: TCustomListView;  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Assigned(Item.Data) and not TTestResult(Item.Data).Ok then
  begin
    Sender.Canvas.Brush.Color := clRed;
    Sender.Canvas.FillRect(Item.DisplayRect(drSelectBounds));
  end;
end;

procedure TUnitTestForm.ListView1DblClick(Sender: TObject);
var
  p: TPoint;
  li: TListItem;
begin
  p := Mouse.CursorPos;
  p := ListView1.ScreenToClient(p);
  li := ListView1.GetItemAt(p.X, p.Y);

  if Assigned(li) and not TTestResult(li.Data).Ok then
  begin
    tsLog.Enabled := True;
    Memo1.Text := TTestResult(li.Data).Log;
    pcTests.ActivePage := tsLog;
  end;
end;

procedure TUnitTestForm.ListView1Resize(Sender: TObject);
begin
  ListView1.Columns[0].Width := ListView1.ClientWidth;
end;

procedure TUnitTestForm.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
  if not (csDestroying in ComponentState) then
  begin
    if Selected then
      fSelectedItems.Add(Item)
    else
      fSelectedItems.Remove(Item);
    actLog.Enabled := fSelectedItems.Count >= 0;
  end;
end;

procedure TUnitTestForm.RefreshList;
var
  p: Pointer;
begin
  ListView1.Items.Clear;
  fSelectedItems.Clear;
  actLog.Enabled := False;
  for p in fResults do
  begin
    if All or not TTestResult(p).Ok then
      ListView1.AddItem(TTestResult(p).Name, TTestResult(p));
  end;
end;

class procedure TUnitTestForm.Run(const ShowFailuredOnly: Boolean = True);
var
  f: TUnitTestForm;
begin
  Application.CreateForm(TUnitTestForm, f);
  f.Show;
  f.actAllResults.Checked := not ShowFailuredOnly;
  f.sbRun.Click;
  Application.Run;
end;

{ TTestFailuredResult }

constructor TTestResult.CreateFailured(const aTestProc: TTestProc; const aName, aLog: string);
begin
  fName := aName;
  fLog := aLog;
  fTestProc := aTestProc;
end;

constructor TTestResult.CreateOk(const aName: string);
begin
  fName := aName;
end;

function TTestResult.GetOk: Boolean;
begin
  Result := @fTestProc = nil;
end;

end.
